home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbsto2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-26  |  8.5 KB  |  202 lines
  1. (*===========================================================================*)
  2. (* Send msg to -- subroutines                                                *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. PROCEDURE more_address;
  10.  
  11.   VAR
  12.     i           : BYTE;
  13.     j           : INTEGER;
  14.     k           : BYTE;
  15.     l           : BYTE;
  16.  
  17.   BEGIN;
  18.  
  19.     WITH active_tcb^.curr_msg.msg_i_mb DO
  20.       WHILE address_string <> '' DO
  21.         BEGIN;
  22.  
  23.           (*-----------------------------------------------------------------*)
  24.           (* Get the data we need                                            *)
  25.           (*-----------------------------------------------------------------*)
  26.  
  27.           save_char   := address_string[1];
  28.           word_cnt    := words(address_string);
  29.           word_string := upcase_str(subword(@address_string, 2, 1));
  30.  
  31.           (*-----------------------------------------------------------------*)
  32.           (* Don't allow < unless BBS or higher                              *)
  33.           (*-----------------------------------------------------------------*)
  34.  
  35.           IF (save_char = '<')
  36.                    AND ((active_tcb^.uid_data.user_flag AND user_f_pbbs) = 0)
  37.                    AND (active_tcb^.uid_data.user_class < user_c_bu) THEN
  38.             save_char := ' ';
  39.  
  40.           (*-----------------------------------------------------------------*)
  41.           (* Execute proper routine                                          *)
  42.           (*-----------------------------------------------------------------*)
  43.  
  44.           CASE save_char OF
  45.  
  46.             (*---------------------------------------------------------------*)
  47.             (* Look for the @ bbs and handle                                 *)
  48.             (*---------------------------------------------------------------*)
  49.  
  50.             '@' : BEGIN;
  51.  
  52.                     (*-------------------------------------------------------*)
  53.                     (* Check for valid format                                *)
  54.                     (*-------------------------------------------------------*)
  55.  
  56.                     IF (word_cnt = 1) OR (address_string[2] <> ' ')  THEN
  57.                       BEGIN;
  58.                         send_message(message_addr_fmt);
  59.                         active_tcb^.error_sw := TRUE;
  60.                         EXIT;
  61.                       END;
  62.  
  63.                     (*-------------------------------------------------------*)
  64.                     (* Find the first address divider                        *)
  65.                     (*     j = position of first address divider             *)
  66.                     (*-------------------------------------------------------*)
  67.  
  68.                     i := LENGTH(address_dividers);
  69.                     j := LENGTH(word_string) + 1;
  70.  
  71.                     FOR k := 1 TO i DO
  72.                       BEGIN;
  73.                         l := POS(address_dividers[k], word_string);
  74.                         IF (l <> 0) AND (l < j) THEN
  75.                           j := l;
  76.                       END;
  77.  
  78.                     (*-------------------------------------------------------*)
  79.                     (* Calculate secondary address size                      *)
  80.                     (*     l = length of secondary address                   *)
  81.                     (*-------------------------------------------------------*)
  82.  
  83.                     IF j < LENGTH(word_string) THEN
  84.                       l := LENGTH(word_string) - j
  85.                     ELSE
  86.                       l := 0;
  87.  
  88.                     (*-------------------------------------------------------*)
  89.                     (* Verify that the sizes are ok and that we don't start  *)
  90.                     (* with an address divider                               *)
  91.                     (*-------------------------------------------------------*)
  92.  
  93.                     IF (j = 1)
  94.                                 OR ((j - 1) >= SIZEOF(msg_to_at))
  95.                                 OR (l >= SIZEOF(msg_to_h)) THEN
  96.                       BEGIN;
  97.                         send_message(message_addr_fmt);
  98.                         active_tcb^.error_sw := TRUE;
  99.                         EXIT;
  100.                       END;
  101.  
  102.                     (*-------------------------------------------------------*)
  103.                     (* Set primary address                                   *)
  104.                     (*-------------------------------------------------------*)
  105.  
  106.                     msg_to_at := COPY(word_string, 1, j-1);
  107.  
  108.                     IF active_port^.port_suppress_ssid THEN
  109.                       msg_to_at := strip_ssid(msg_to_at);
  110.  
  111.                     (*-------------------------------------------------------*)
  112.                     (* Set secondary (hierarchial) address                   *)
  113.                     (*-------------------------------------------------------*)
  114.  
  115.                     IF l > 0 THEN
  116.                       BEGIN;
  117.                         msg_to_h  := COPY(word_string, j + 1, 255);
  118.                         msg_flag  := msg_flag OR mf_h_receive;
  119.                       END
  120.                     ELSE
  121.                       BEGIN;
  122.                         msg_to_h := '';
  123.                         msg_flag :=
  124.                               msg_flag AND NOT mf_h_receive;
  125.                       END;
  126.  
  127.                     (*-------------------------------------------------------*)
  128.                     (* Remove processed section                              *)
  129.                     (*-------------------------------------------------------*)
  130.  
  131.                     address_string := subword(@address_string, 3, 0);
  132.  
  133.                   END;
  134.  
  135.             (*---------------------------------------------------------------*)
  136.             (* From someone else                                             *)
  137.             (*---------------------------------------------------------------*)
  138.  
  139.             '<' : BEGIN;
  140.  
  141.                     IF (word_cnt = 1) OR (address_string[2] <> ' ')
  142.                           OR (LENGTH(word_string) >= SIZEOF(msg_from))
  143.                           OR ((NOT match_str(word_string, '+*'))
  144.                                              AND (word_string[1] <> '=')) THEN
  145.                       BEGIN;
  146.                         send_message(message_addr_fmt);
  147.                         active_tcb^.error_sw := TRUE;
  148.                         EXIT;
  149.                       END;
  150.  
  151.                     msg_from    := word_string;
  152.                     msg_from_at := active_tcb^.uid_data.user_id;
  153.  
  154.                     address_string := subword(@address_string, 3, 0);
  155.  
  156.                   END;
  157.  
  158.             (*---------------------------------------------------------------*)
  159.             (* Bid                                                           *)
  160.             (*---------------------------------------------------------------*)
  161.  
  162.             '$' : BEGIN;
  163.  
  164.                     word_string := COPY(subword(@address_string, 1, 1), 2, 255);
  165.                     upcase_str_var(word_string);
  166.  
  167.                     IF LENGTH(word_string) > bid_len THEN
  168.                       BEGIN;
  169.                         send_message(message_addr_fmt);
  170.                         active_tcb^.error_sw := TRUE;
  171.                         EXIT;
  172.                       END;
  173.  
  174.                     IF word_string = '' THEN
  175.                       BEGIN;
  176.                         msg_flag := msg_flag OR mf_bid_change;
  177.                         word_string := CHR(0);
  178.                       END;
  179.  
  180.                     msg_bid := word_string;
  181.  
  182.                     address_string := subword(@address_string, 2, 0);
  183.  
  184.                   END;
  185.  
  186.             (*---------------------------------------------------------------*)
  187.             (* Everything else                                               *)
  188.             (*---------------------------------------------------------------*)
  189.  
  190.             ELSE
  191.               BEGIN;
  192.                 send_message(message_addr_fmt);
  193.                 active_tcb^.error_sw := TRUE;
  194.                 EXIT;
  195.               END;
  196.  
  197.           END; (*----- End case statement -----------------------------------*)
  198.  
  199.         END; (*----- End WHILE loop -----------------------------------------*)
  200.  
  201.   END;
  202.